home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 August / Software of the Month Club 1996 August.iso / pc / os2 / famtree / imgedcom.ftx < prev    next >
Encoding:
Text File  |  1996-05-25  |  14.4 KB  |  503 lines
  1. /*
  2.    Family Tree Rexx Script FTX
  3.  
  4.    Copyright (C) 1996 by <Nils Meier>
  5.  
  6.    Please send comments to / Kommentar bitte an
  7.         meier2@athene.informatik.uni-bonn.de
  8.  
  9.    <This script imports a family tree from a GEDCOM file
  10.     / Dieses Skript importiert einen Stammbaum aus einer GEDCOM Datei.>
  11. */
  12.  
  13.  
  14. /* ----------------------- Params  /  Parameter ------------------- */
  15. datasex   = 'MW'
  16. datamonth = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
  17. crlf      = '0d0a'x
  18.  
  19. IF getLanguage()='Deutsch' THEN DO
  20.    header      = 'Importieren von GEDCOM-Daten :'
  21.    select      = 'GEDCOM-Import-Datei angeben:'
  22.    fileerror   = 'Fehler: Einladen von '
  23.    nogedcom    = 'Fehler: Keine GEDCOM-Datei '
  24.    foundheader = 'HEADER gefunden !'
  25.    done        = 'Fertig !'
  26.    sourceis    = 'Quellsystem ist '
  27.    sourcedate  = 'Hergestellt am '
  28.    unexpected  = 'Unerwartetes Ende der Datei !'
  29.    ignoring    = 'Beim Einlesen wurden ignoriert: '
  30.    oopsDate    = 'Undeutliches Datum  : '
  31.    oopsSex     = 'Undeutliches Geschl : '
  32.    oopsID      = 'Undeutliche  ID     : '
  33.    importstart = 'Starte jetzt Berechnung des Stammbaumes !'crlf'Die letzte Person aus der GEDCOM-Datei wird Ursprung :'
  34. END
  35. ELSE DO
  36.    header      = 'Importing from GEDCOM :'
  37.    select      = 'Select GEDCOM file for import:'
  38.    fileerror   = 'Error: Reading from '
  39.    nogedcom    = 'Error: No GEDCOM file '
  40.    foundheader = 'Found HEADER !'
  41.    done        = 'Done !'
  42.    sourceis    = 'Source system is '
  43.    sourcedate  = 'Produced at '
  44.    unexpected  = 'Unexpected end of file !'
  45.    ignoring    = 'Had to ignore during load:'
  46.    oopsDate    = 'Ambiguous Date : '
  47.    oopsSex     = 'Ambiguous Sex  : '
  48.    oopsID      = 'Ambiguous ID   : '
  49.    importstart = 'Starting Calculation of family tree !'crlf'Last person in GEDCOM-file becomes Origin :'
  50. END
  51.  
  52. /* ----------------- Display Header / Kopf der Ausgabe ------------- */
  53. SAY(header||DATE())
  54. SAY('')
  55.  
  56.  
  57. /* ------------------- Open file  /  Datei oeffnen  ---------------- */ 
  58. file=getFileName(select,'*.GED')
  59. IF (file='') THEN DO
  60.    SAY(done)
  61.    RETURN
  62.    END
  63.  
  64. rc=LINEIN(file,1,0)
  65. rc=LINES(file)
  66. IF (rc=0) THEN DO
  67.    SAY(fileerror||file)
  68.    RETURN
  69.    END
  70.  
  71. /* -------------- Header of GEDCOM  /  Kopf von GEDCOM -------------- */
  72.  
  73. input=LINEIN(file)
  74. PARSE VAR input lev tag
  75. IF (lev<>0)|(tag<>'HEAD') THEN DO 
  76.    SAY(nogedcom||file||' (Expected 0 HEAD)')
  77.    RETURN
  78.    END
  79. SAY(foundheader)
  80. rc=inputFromGedcom()
  81. DO FOREVER
  82.    PARSE VAR input lev tag value
  83.    SELECT
  84.      WHEN rc<>'' THEN LEAVE
  85.      WHEN lev='0' THEN LEAVE
  86.      WHEN tag='SOUR' THEN SAY(sourceis||'"'||value||'"')
  87.      WHEN tag='DATE' THEN SAY(sourcedate||'"'||value||'"')
  88.      OTHERWISE NOP
  89.    END
  90.    rc=waitLev(1)
  91. END
  92. SAY('')
  93. IF rc<>'' THEN DO
  94.    SAY(rc)
  95.    RETURN
  96. END
  97.  
  98.  
  99. /* ---- Read Persons&Families / Personen und Familien einlesen --- */
  100.  
  101. PIgnored=''
  102. FIgnored=''
  103. SIgnored=''
  104.  
  105. DO FOREVER
  106.    PARSE VAR input lev tag1 tag2 rest
  107.    /* Check for INDI & FAM  /  Suchen nach INDI & FAM */
  108.    SELECT
  109.      WHEN rc<>'' THEN LEAVE
  110.      WHEN tag2='INDI' THEN rc=readPerson()
  111.      WHEN tag2='FAM'  THEN rc=readFamily()
  112.      WHEN tag1='TRLR' THEN LEAVE
  113.      OTHERWISE DO
  114.         IF WORDPOS(tag2,SIgnored)=0 THEN SIgnored=SIgnored tag2
  115.         rc=waitLev(0)
  116.      END
  117.    END
  118.    /* Next Datapacket /  Naechster Datensatz */
  119. END
  120. SAY('')
  121.  
  122. /* ------------------ End of Import  /  Ende des Imports --------------- */
  123.  
  124. IF rc='' THEN DO
  125.  
  126.    SAY(ignoring '(Structs)')
  127.    SAY(SIgnored)
  128.    SAY('')
  129.  
  130.    SAY(ignoring '(in INDI)')
  131.    SAY(PIgnored)
  132.    SAY('')
  133.  
  134.    SAY(ignoring '(in FAM)')
  135.    SAY(FIgnored)
  136.    SAY('')
  137.  
  138.    SAY(importstart)
  139.    SAY(importDone())
  140.  
  141.  
  142.    SAY(done)
  143.    END
  144. ELSE
  145.    SAY(rc)
  146.  
  147.  
  148. RETURN
  149.  
  150.  
  151.  
  152.  
  153. /* =============== Read Functions / Lesefunktionen =============== */
  154.  
  155.  
  156. /* ------------- Read Person  /  Person einlesen ------------------ */
  157.  
  158. readPerson:
  159.    id=WORD(input,2)  /* Needed for Ambiguous */
  160.  
  161.    PID        =calcID(id)
  162.    PAddr      =''
  163.    PNote      =''
  164.  
  165.    IF PID=0 THEN RETURN(waitLev(0))
  166.    rc=importPerson()
  167.    ok=setPID(PID)
  168.  
  169.    rc=inputFromGedcom()   /* input = lev tag value */
  170.    DO FOREVER
  171.      lev  =   WORD(input,1)
  172.      tag  =   WORD(input,2)
  173.      value=SUBWORD(input,3)
  174.  
  175.      /* ---- Take data   / Daten übernehmen --- */
  176.      SELECT
  177.        /*-------------------------------------------*/
  178.        WHEN rc<>''  THEN RETURN(rc||'('||id||')')
  179.        WHEN lev=0 THEN LEAVE
  180.        /*-------------------------------------------*/
  181.        WHEN tag='NAME' THEN DO
  182.          PARSE VAR value fname1 '/' name '/' fname2
  183.          ok=setName(STRIP(name))
  184.          ok=setFirstName(STRIP(fname1||fname2))
  185.          rc=waitLev(1)
  186.        END
  187.        /*-------------------------------------------*/
  188.        WHEN tag='SEX' THEN DO
  189.          ok=setSex(calcSex(value))
  190.          rc=waitLev(1)
  191.        END
  192.        /*-------------------------------------------*/
  193.        WHEN tag='BIRT' THEN DO
  194.          rc=inputFromGedcom()  /* input = lev tag value */
  195.          DO FOREVER
  196.             lev=WORD(input,1)
  197.             tag=WORD(input,2)
  198.             SELECT
  199.               WHEN rc<>''     THEN LEAVE
  200.               WHEN lev<=1     THEN LEAVE
  201.               WHEN tag='DATE' THEN ok=setBirthDate(calcDate(SUBWORD(input,3)))
  202.               WHEN tag='PLAC' THEN ok=setBirthPlace(SUBWORD(input,3))
  203.               OTHERWISE NOP
  204.             END
  205.             rc=waitLev(2)
  206.          END
  207.        END
  208.        /*-------------------------------------------*/
  209.        WHEN tag='DEAT' THEN DO
  210.          rc=inputFromGedcom()  /* input = lev tag value */
  211.          DO FOREVER
  212.             lev=WORD(input,1)
  213.             tag=WORD(input,2)
  214.             SELECT
  215.               WHEN rc<>''     THEN LEAVE
  216.               WHEN lev<=1     THEN LEAVE
  217.               WHEN tag='DATE' THEN ok=setDeathDate(calcDate(SUBWORD(input,3)))
  218.               WHEN tag='PLAC' THEN ok=setDeathPlace(SUBWORD(input,3))
  219.               OTHERWISE NOP
  220.             END
  221.             rc=waitLev(2)
  222.          END
  223.        END
  224.        /*-------------------------------------------*/
  225.        WHEN tag='PHOT' THEN DO
  226.          ok=setPicture(value)
  227.          rc=waitLev(1)
  228.        END
  229.        /*-------------------------------------------*/
  230.        WHEN tag='OCCU' THEN DO
  231.          ok=setOccupation(value)
  232.          rc=waitLev(1)
  233.        END
  234.        /*-------------------------------------------*/
  235.        WHEN tag='ADDR' THEN DO
  236.          addr=value
  237.          rc=inputFromGedcom()  /* input = lev tag value */
  238.          DO FOREVER
  239.             lev=WORD(input,1)
  240.             tag=WORD(input,2)
  241.             SELECT
  242.               WHEN rc<>''     THEN LEAVE
  243.               WHEN lev<=1   THEN LEAVE
  244.               WHEN tag='CONT' THEN addr=addr||','||SUBWORD(input,3)
  245.               WHEN tag='PHON' THEN addr=addr||','||SUBWORD(input,3)
  246.               OTHERWISE NOP
  247.             END
  248.             rc=waitLev(2)
  249.          END
  250.          IF PAddr<>'' THEN PAddr=PAddr||','
  251.          PAddr=PAddr||addr
  252.        END
  253.        /*-------------------------------------------*/
  254.        WHEN tag='PHON' THEN DO
  255.          IF PAddr<>'' THEN PAddr=PAddr||','
  256.          PAddr=PAddr||value
  257.          rc=waitLev(1)
  258.        END
  259.        /*-------------------------------------------*/
  260.        WHEN tag='NOTE' THEN DO
  261.          PNote=value
  262.          rc=inputFromGedcom()  /* input = lev tag value */
  263.          DO FOREVER
  264.             lev=WORD(input,1)
  265.             tag=WORD(input,2)
  266.             SELECT
  267.               WHEN rc<>''     THEN LEAVE
  268.               WHEN lev<=1     THEN LEAVE
  269.               WHEN tag='CONT' THEN PNote=PNote||crlf||SUBWORD(input,3)
  270.               OTHERWISE NOP
  271.             END
  272.             rc=waitLev(2)
  273.          END
  274.        END
  275.        /*-------------------------------------------*/
  276. /*
  277.        WHEN tag='FAMC' THEN DO
  278.          PChildren=PChildren value
  279.          rc=waitLev(1)
  280.        END
  281.        /*-------------------------------------------*/
  282.        WHEN tag='FAMS' THEN DO
  283.          PSpouses=PSpouses value
  284.          rc=waitLev(1)
  285.        END
  286. */
  287.        /*-------------------------------------------*/
  288.        OTHERWISE DO
  289.          IF WORDPOS(tag,PIgnored)=0 THEN PIgnored=PIgnored tag
  290.          rc=waitLev(1)
  291.        END
  292.        /*-------------------------------------------*/
  293.      END
  294.    END
  295.  
  296.    ok=setAddress(PAddr)
  297.    ok=setMemo(PNote)
  298.  
  299.    RETURN('')
  300.  
  301.  
  302. /* ------------- Read Family  /  Familie einlesen ------------------ */
  303.  
  304. readFamily:
  305.  
  306.    id=WORD(input,2)  /* Needed for Ambiguous */
  307.  
  308.    FID        =calcID(id)
  309.    IF FID=0 THEN RETURN(waitLev(0))
  310.  
  311.    rc=importFamily()
  312.    ok=setFID(FID)
  313.  
  314.    rc=inputFromGedcom()   /* input = lev tag value */
  315.    DO FOREVER
  316.      lev  =   WORD(input,1)
  317.      tag  =   WORD(input,2)
  318.      value=SUBWORD(input,3)
  319.  
  320.      /* ---- Take data   / Daten übernehmen --- */
  321.      SELECT
  322.        /*-------------------------------------------*/
  323.        WHEN rc<>'' THEN RETURN(rc||'('||id||')')
  324.        WHEN lev=0  THEN LEAVE
  325.        /*-------------------------------------------*/
  326.        WHEN tag='HUSB' THEN DO
  327.          ok=importAddPartner(calcID(value))
  328.          rc=waitLev(1)
  329.        END
  330.        /*-------------------------------------------*/
  331.        WHEN tag='WIFE' THEN DO
  332.          ok=importAddPartner(calcID(value))
  333.          rc=waitLev(1)
  334.        END
  335.        /*-------------------------------------------*/
  336.        WHEN tag='MARR' THEN DO
  337.          rc=inputFromGedcom()  /* input = lev tag value */
  338.          DO FOREVER
  339.             lev=WORD(input,1)
  340.             tag=WORD(input,2)
  341.             SELECT
  342.               WHEN rc<>''     THEN LEAVE
  343.               WHEN lev<=1   THEN LEAVE
  344.               WHEN tag='DATE' THEN ok=setMarriageDate(calcDate(SUBWORD(input,3)))
  345.               WHEN tag='PLAC' THEN ok=setMarriagePlace(SUBWORD(input,3))
  346.               OTHERWISE NOP
  347.             END
  348.             rc=waitLev(2)
  349.          END
  350.        END
  351.        /*-------------------------------------------*/
  352.        WHEN tag='DIV' THEN DO
  353.          rc=inputFromGedcom()   /* input = lev tag value */
  354.          DO FOREVER
  355.             lev=WORD(input,1)
  356.             tag=WORD(input,2)
  357.             SELECT
  358.               WHEN rc<>''     THEN LEAVE
  359.               WHEN lev<=1     THEN LEAVE
  360.               WHEN tag='DATE' THEN ok=setDivorceDate(calcDate(SUBWORD(input,3)))
  361.               OTHERWISE NOP
  362.             END
  363.             rc=waitLev(2)
  364.          END
  365.        END
  366.        /*-------------------------------------------*/
  367.        WHEN tag='CHIL' THEN DO
  368.          ok=importAddChild(calcID(value))
  369.          rc=waitLev(1)
  370.        END
  371.        /*-------------------------------------------*/
  372.        OTHERWISE DO
  373.          IF WORDPOS(tag,FIgnored)=0 THEN FIgnored=FIgnored tag
  374.          rc=waitLev(1)
  375.        END
  376.        /*-------------------------------------------*/
  377.      END
  378.    END
  379.  
  380.    RETURN('')
  381.  
  382.  
  383. /* =============== Auxilary Functions / Hilfsfunktionen =============== */
  384.  
  385. /* ------------- Ignore SubTags  /  SubTags ignorieren ---------------- */
  386.  
  387. waitLev:
  388.    ARG u
  389.    DO FOREVER
  390.      rc=inputFromGedcom()
  391.      IF rc<>'' THEN RETURN(rc)
  392.      IF WORD(input,1)<=u THEN RETURN('')
  393.    END
  394.  
  395.  
  396. /* ------------ Read GedcomLine  /  GedcomZeile einlesen ------------- */
  397. inputFromGedcom:
  398.    IF LINES(file)=0 THEN RETURN(unexpected)
  399.    input=LINEIN(file)
  400.    RETURN('')
  401.  
  402.  
  403. /* ---------------- Calculate ID  /  ID berechnen -------------------- */
  404. calcID:
  405.    i=SPACE(TRANSLATE(ARG(1),'','@IF'),0)
  406.    IF (DATATYPE(i)='NUM')&(i>0) THEN RETURN(i)
  407.    SAY(oopsID||id||' ('||ARG(1)||')')
  408.    RETURN(0)   
  409.  
  410.  
  411. /* --------- Calculate Sex (0/1/2) /  Geschlecht berechnen ----------- */
  412. calcSex:
  413.    t=STRIP(ARG(1))
  414.    SELECT
  415.      WHEN t=''  THEN RETURN(0)
  416.      WHEN ABBREV(t,'M') THEN RETURN(1)
  417.      WHEN ABBREV(t,'F') THEN RETURN(2)
  418.      WHEN ABBREV(t,'m') THEN RETURN(1)
  419.      WHEN ABBREV(t,'f') THEN RETURN(2)
  420.      WHEN ABBREV(t,'W') THEN RETURN(2)
  421.      WHEN ABBREV(t,'w') THEN RETURN(2)
  422.      OTHERWISE NOP
  423.    END
  424.    SAY(oopsSex||id||' ('||ARG(1)||')')
  425.    RETURN(0)
  426.  
  427.  
  428. /* --------------- Calculate Date  /  Datum berechnen ---------------- */
  429. calcDate:
  430.    /* ------------- '' --------------------- */
  431.    IF ARG(1)='' THEN RETURN('0.0.0')
  432.  
  433.    /* -------------- PARSE ----------------- */ 
  434.    date=TRANSLATE(ARG(1),'00','_?')
  435.    SELECT
  436.       WHEN POS('-',date)>0 THEN PARSE VAR date day '-' month '-' year
  437.       WHEN POS('.',date)>0 THEN PARSE VAR date day '.' month '.' year
  438.       WHEN POS('/',date)>0 THEN PARSE VAR date month '/' day '/' year
  439.       OTHERWISE PARSE VAR date day ' ' month ' ' year
  440.    END
  441.  
  442.    year=SUBSTR(year,1,4)
  443.    daytype  =DATATYPE(day)
  444.    monthtype=DATATYPE(month)
  445.    yeartype =DATATYPE(year)
  446.    /* ----- 'dd mm yyyy' ------------------- */
  447.    IF (daytype='NUM')&(monthtype='NUM')&(yeartype='NUM') THEN DO
  448.       IF (month>12)&(month<32) THEN RETURN(month||'.'||day||'.'||year)
  449.       ELSE                          RETURN(day||'.'||month||'.'||year)
  450.       END
  451.    /* ----- 'dd MMM yyyy' ------------------- */
  452.    IF (daytype='NUM')&(yeartype='NUM') THEN DO
  453.       p=WORDPOS(month,datamonth)
  454.       IF (p>0) THEN RETURN(day||'.'||p||'.'||year)
  455.       END
  456.    /* ----- 'dd MMM' ----------------------- */
  457.    IF (daytype='NUM')&(monthtype='CHAR')&(year='') THEN DO
  458.       p=WORDPOS(month,datamonth)
  459.       IF (p>0) THEN RETURN(day||'.'||p||'.'||0)
  460.       END
  461.    /* ----- 'dd mm' ------------------------ */
  462.    IF (daytype='NUM')&(monthtype='NUM')&(year='') THEN
  463.       RETURN(day||'.'||month||'.'||year)
  464.    /* ----- 'dd __ yyyy' ------------------- */
  465.    IF (daytype='NUM')&(month='')&(yeartype='NUM') THEN
  466.       RETURN(day||'.'||0||'.'||year)
  467.  
  468.  
  469.    date=DELWORD(TRANSLATE(date,'','-/.'),4)
  470.    
  471.    dcount  =WORDS(date)
  472.    datetype=DATATYPE(date)
  473.    /* ----- '__ __ yyyy' ------------------- */
  474.    IF (dcount=1)&(datetype='NUM') THEN 
  475.       RETURN(0||'.'||0||'.'||date)
  476.    /* ----- '__ MMM __' ---------------- */
  477.    IF (dcount=1) THEN DO
  478.       p=WORDPOS(date,datamonth)
  479.       if (p>0) THEN RETURN(0||'.'||p||'.'||0)
  480.       END
  481.  
  482.    word1    =WORD(date,1)
  483.    word2    =WORD(date,2)
  484.    word1type=DATATYPE(word1)
  485.    word2type=DATATYPE(word2)
  486.    /* ----- '__ mm|MMM YYYY' ---------------- */
  487.    IF (dcount=2)&(word2type='NUM') THEN DO
  488.       IF (word1type='NUM')&(word1<13) THEN
  489.          RETURN(0||'.'||word1||'.'||word2)
  490.       p=WORDPOS(word1,datamonth)
  491.       IF p>0 THEN
  492.          RETURN(0||'.'||p||'.'||word2)
  493.       END
  494.  
  495.    /* ----- ???????????? ------------------- */
  496.    SAY(oopsDate||id||' ('||ARG(1)||')')
  497.    return('0||'.'||0||'.'||0')
  498.  
  499.  
  500.  
  501.  
  502.  
  503.